Modifying the typical plot of cumulative cases per country, either log or raw scale, to adjust for population. Why?
When comparisons first began, Hubei province and subsequently South Korea, Italy, Spain, Germany and France all have populations of approximtaley 60 Million people and arguably similar standards of living and health care. New Zealand though is an ordr of magnitude lower and the US nearly an order higher. In simple terms, New Zealand has far less hospital capacity and the US far higher as an absolute value. So absolute values are not interesting, adjusting for population size is.
I still need to tidy the plot.
I have a shiny app to deploy here soon
The Coronavirus Dashboard: the case of New Zealand
This Coronavirus dashboard provides an overview of the 2019/20 Novel Coronavirus COVID-19 (2019-nCoV) epidemic for New Zealand. This dashboard is built with R using the R Makrdown framework with Flexadashboard. Think of it as a living thing, it will change, like the change of going into a minimum of a month long lockdown. The data will not match that presented each day at 1pm (at the moment), there are differences in how data is reported by various sources, perhaps in time I will switch to the Ministry of Health for the New Zealand Data.
note: I have waited longer to share, but Greig Hamilton is impatient. Some of his work that I helped on can be found here not that he’d ever give me credit for it.
Code
The code behind this dashboard is available on GitHub.
The original layout and first use of data came from Rami Krispin who created both a dashboard and a package with the Johns Hopkins Data
Data
The input data for this dashboard is the dataset available from the European Centre for Disease Prevention and Control
The data and dashboard are refreshed on a daily basis.
Some data is also pulled from the Johns Hopkins University Center for Systems Science and Engineering (JHU CCSE) Coronavirus repository. But I find that is late to update due to time zone differences.
Contact
For any question or feedback, you can email me mattbixley72@gmail.com or report an issue at the GitHub repo
Update
The data is as of Saturday March 28, 2020 and the dashboard has been updated on Saturday March 28, 2020 at 21:04.
---
title: "**COVID19 - New Zealand**"
author: "**Matt Bixley**"
output:
flexdashboard::flex_dashboard:
orientation: rows
source_code: embed
vertical_layout: fill
theme: bootstrap
#logo: images/coronavirus.png
---
```{r setup, include=FALSE}
#------------------ Packages ------------------
library(flexdashboard)
library(tidyverse)
library(lubridate)
library(scales)
#------------------ Parameters ------------------
# cases today
nzcases = 83
nzdeaths = 0
#------------------ Data ------------------
source("code/import_jhu.R")
source("code/insert_today.R")
#source("code/population.R")
# read the jhu set for the lat/long
jhu_confirmed <- "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_confirmed_global.csv"
jhu <- read_csv(jhu_confirmed) %>%
rename(country = "Country/Region") %>%
map_df(str_replace_all, pattern = " ", replacement = "_") %>%
mutate(country = ifelse(country == "Taiwan*", "Taiwan",country)) %>%
mutate(country = ifelse(country == "Korea,_South", "South_Korea",country)) %>%
mutate(country = ifelse(country == "US", "United_States_of_America",country)) %>%
group_by(country) %>% # hack to get just one copy of country
mutate(first = rank(country)) %>%
filter(first == 1) %>%
select(country, Lat, Long)
# Import from the European CDC
ecdc_url <- "https://opendata.ecdc.europa.eu/covid19/casedistribution/csv/"
download.file(url = ecdc_url, destfile = "data/ecdc.csv")
covid19 <- read_csv("data/ecdc.csv") %>%
rename(date = "dateRep", country = "countriesAndTerritories", population = "popData2018") %>%
left_join(.,jhu) %>% # merge with jhu to get the lat long
mutate(date = dmy(date)) %>%
arrange(date, country) %>%
mutate(population = ifelse(country == "China", 58500000/0.83, population)) %>% #correct pop to reflect hubei
group_by(country) %>%
mutate(cum_cases = cumsum(cases)) %>%
mutate(cum_deaths = cumsum(deaths)) %>%
ungroup() %>%
mutate(country = ifelse(country == "United_States_of_America", "USA",country)) %>% # per capita
filter(country != "Cases_on_an_international_conveyance_Japan")
covid19 <- insert_today(cases = nzcases, deaths = nzdeaths)
covid19 <- covid19 %>%
mutate(per_million = round(cum_cases/population*1000000,1)) %>%
mutate(daily_million = round(cases/population*100000,3))
# need to add a time limiting function here for europe update
latest <- covid19 %>% filter(date == max(date))
nz <- covid19 %>% filter(country == "New_Zealand")
usa <- covid19 %>% filter(country == "USA")
italy <- covid19 %>% filter(country == "Italy")
```
Sidebar {.sidebar}
=====================================
__**The Lockdown Diaries**__
Updates likely 9am NZDT with the over night European data. Just after 1pm NZDT with the New Zealand daily news and sometime in the evening.
{ width=100% }
**Saturday March 28th** (d3)
Strength, Run, Walk and moved gear into the new walkin wardrobe
Bullied to share this link.
**Friday March 27th** (d2)
Got this dashboard underway
3x1min Boats, 2x1min Russian Twists
2x1min Supermans each pair
**Thursday March 26th** (d1)
Home D - loving it
PE instituted for the kids (Not Happy)
3x20 Pushups
3x10 Squat Jumps
30 minute run
**Wednesday March 25th** (d-1)
Mitre10 for Paint rollers and bits and pieces
NZDataScience Zoom Morning Tea
Builders cleaned the windows
Sparky rigged up the Hotwater Cylinder in the extension (good bastard)
3x1min Boats
2x1min Russian Twists
3x10 Forward Lunges
30 minute run
**Tuesday March 24th** (d-2)
Set up the home office, nipped down to work for a chair
5x1min Planks
3x10 Reverse Lunges
30 minute run
**Summary**
=======================================================================
Row {data-width=400}
-----------------------------------------------------------------------
### confirmed {.value-box}
```{r}
#valueBox(value, subtitle, icon = NULL, color = "aqua", width = 4,href = NULL)
valueBox(
value = paste(format(max(nz$cum_cases), big.mark = ","), "", sep = " "),
caption = "Total confirmed cases",
icon = "fas fa-user-md",
color = "silver"
)
```
### active {.value-box}
```{r}
valueBox(
value = paste(format(max(nz$per_million), big.mark = ","), "", sep = " "),
caption = "Cases per million",
icon = "fas fa-user-md",
color = "silver"
)
```
### update {.value-box}
```{r}
valueBox(
value = paste0(format(Sys.time(), "%B %d"),", ",format(Sys.time(), "%H:%M")),
caption = "Updated",
icon = "fas fa-clock",
color = "silver"
)
```
Column {data-width=400}
-------------------------------------
### **Notes**
Modifying the typical plot of cumulative cases per country, either log or raw scale, to adjust for population. Why?
When comparisons first began, Hubei province and subsequently South Korea, Italy, Spain, Germany and France all have populations of approximtaley 60 Million people and arguably similar standards of living and health care. New Zealand though is an ordr of magnitude lower and the US nearly an order higher. In simple terms, New Zealand has far less hospital capacity and the US far higher as an absolute value. So absolute values are not interesting, adjusting for population size is.
*I still need to tidy the plot.*
### **Daily Per Capita Cases**
```{r}
# plot nz growth
#who <- "New Zealand"
who <- c("New_Zealand", "Australia", "USA", "Italy", "China", "South_Korea")
p1 <- covid19 %>% filter(country %in% who, per_million > 5) %>%
group_by(country) %>%
mutate(days5 = dense_rank(date)) %>%
ggplot(aes(x = days5, y = per_million, colour = country)) +
geom_point() +
geom_line() +
ggtitle("Per Capita Cumulative Cases\n days since 5/million") +
xlab("Days") + ylab("Cases\n(per Million People)")
p1 + theme_bw()
```
**Plots**
=======================================================================
Column {data-width=400}
-------------------------------------
### **Cumulative Cases**
```{r}
#----------------------------------------
# Plotting the data
who <- c("New_Zealand", "Australia", "USA", "Italy", "China", "South_Korea")
p2 <- covid19 %>% filter(country %in% who , cum_cases > 0) %>%
group_by(country) %>%
mutate(days = dense_rank(date)) %>%
ungroup() %>%
ggplot(aes(x = days, y = cum_cases, colour = country)) +
geom_point() +
geom_line() +
scale_y_continuous(trans = "log10",
breaks = trans_breaks("log10",function(x) 10^x), labels = trans_format("log10", math_format(10^.x))) +
ggtitle("Cumulative Cases (log scale)\n days since 1st case") +
xlab("Days") + ylab("Cumulative Cases")
p2 + theme_bw()
```
### **Daily Cases** plot needs work
```{r}
who <- c("New_Zealand", "Australia", "USA", "Italy", "China", "South_Korea")
who <- covid19 %>% filter(cum_cases > 400) %>%
select(country) %>%
distinct()
p3 <- covid19 %>% filter(country %in% who$country) %>%
#mutate(daily_million = ifelse(daily_million == 0, NA, daily_million)) %>%
ggplot(aes(x = date, y = country, fill = daily_million)) +
geom_tile(colour = "white") +
scale_fill_gradient(low = "white", high = "orangered4",
name = "Per Million") +
ggtitle("Per Capita Case Incidence \n days since 5 cases/million") +
xlab("Days") + ylab("Cases/Million")
p3 + #theme_wsj(color = "gray", ) + scale_colour_wsj() +
theme_bw() +
theme(axis.text.y = element_text(size = 5))
```
**Map**
=======================================================================
### **World map of cases**
Map Coming Soon
```{r}
# make a map
#library(leaflet)
#library(leafpop)
#map_object %>%
# addLayersControl(
# overlayGroups = names(cv_data_for_plot.split),
# options = layersControlOptions(collapsed = FALSE)
# )
```
**Epidemiology**
=======================================================================
I have a shiny app to deploy here soon
**About**
=======================================================================
**The Coronavirus Dashboard: the case of New Zealand**
This Coronavirus dashboard provides an overview of the 2019/20 Novel Coronavirus COVID-19 (2019-nCoV) epidemic for New Zealand. This dashboard is built with R using the R Makrdown framework with Flexadashboard. Think of it as a living thing, it will change, like the change of going into a minimum of a month long lockdown. The data will not match that presented each day at 1pm (at the moment), there are differences in how data is reported by various sources, perhaps in time I will switch to the [Ministry of Health](https://www.health.govt.nz/our-work/diseases-and-conditions/covid-19-novel-coronavirus) for the New Zealand Data.
note: I have waited longer to share, but Greig Hamilton is impatient. Some of his work that I helped on can be found [here](http://www.rogaine-results.com/) not that he'd ever give me credit for it.
**Code**
The code behind this dashboard is available on [GitHub](https://github.com/mattbixley/covid19){target="_blank"}.
The original layout and first use of data came from [Rami Krispin](https://github.com/RamiKrispin/coronavirus_dashboard){target="_blank"} who created both a dashboard and a package with the Johns Hopkins Data [{ width=3%}](https://github.com/RamiKrispin/coronavirus){target="_blank"}
**Data**
The input data for this dashboard is the dataset available from the
[{ width=3%}](https://www.ecdc.europa.eu/en/publications-data/download-todays-data-geographic-distribution-covid-19-cases-worldwide){target="_blank"} European Centre for Disease Prevention and Control
The data and dashboard are refreshed on a daily basis.
Some data is also pulled from the Johns Hopkins University Center for Systems Science and Engineering (JHU CCSE) Coronavirus [repository](https://github.com/CSSEGISandData/COVID-19){target="_blank"}.
But I find that is late to update due to time zone differences.
**Contact**
For any question or feedback, you can email me or report an issue at the [GitHub repo](https://github.com/MattBixley/COVID19/issues){target="_blank"}
**Update**
The data is as of `r format(max(covid19$date), "%A %B %d, %Y")` and the dashboard has been updated on `r format(Sys.time(), "%A %B %d, %Y")` at `r format(Sys.time(), "%H:%M")`.